home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-02 / blaise.zip / BLAISE.PAS < prev    next >
Pascal/Delphi Source File  |  1992-05-01  |  2KB  |  105 lines
  1. program ScreenSaver;
  2.  
  3. uses Wintypes, WinProcs, WObjects, Saver, BWCC;
  4.  
  5. {The below description must start with the {$D SCRNSAVE  and
  6. follow with the name to show up in control panel.  You must
  7. compile this program to an .EXE and copy it to your windows
  8. directory with the extention .SCR. Let me know if this has
  9. problems! Robert J. Warren [76702,1570] }
  10.  
  11. {$D SCRNSAVE Blaise Blast}
  12.  
  13. {$R Blaise.Res}
  14.  
  15. const
  16. NumberOfBitmaps = 2;
  17.  
  18. type
  19.  
  20. TSaveApplication = object(TSApplication)
  21.   procedure InitMainWindow; virtual;
  22.   destructor Done; virtual;
  23.  end;
  24.  
  25. PSaveWindow = ^TSaveWindow;
  26. TSaveWindow = object(TScrnSavWindow)
  27.   hBmp : array[1..NumberofBitmaps] of  hBitmap;
  28.   constructor Init(aParent: PWindowsObject; aTitle: PChar);
  29.   procedure SetupWindow; virtual;
  30.   procedure Animate; virtual;
  31.   destructor Done; virtual;
  32. end;
  33.  
  34. procedure TSaveApplication.InitMainWindow;
  35. begin
  36.  if (ParamStr(1) <> '/c') and (ParamStr(1) <> '-c') then
  37.    MainWindow:= New(PSaveWindow, Init(nil, 'ScreenSaver'))
  38.  else
  39.  begin
  40.    Configure := True;
  41.    MainWindow := New(PDialog, Init(nil, 'ConfigDialog'));
  42.  end
  43. end;
  44.  
  45. constructor TSaveWindow.Init(aParent: PWindowsObject; aTitle: PChar);
  46. begin
  47.   BackGroundColor := Null_Brush;
  48.   TScrnSavWindow.Init(aParent, aTitle);
  49. end;
  50.  
  51. procedure TSaveWindow.SetupWindow;
  52. begin
  53.   Randomize;
  54.   TScrnSavWindow.SetupWindow;
  55.   hBmp[1] := loadBitmap(hInstance, 'Blaise');
  56.   hBmp[2] := loadBitmap(hInstance, 'RaceCar');
  57. end;
  58.  
  59. procedure TSaveWindow.Animate;
  60. var
  61.   MyHdc, MemhDC: hDC;
  62.   BitMp : TBitMap;
  63.   Rect:TRect;
  64.   bmNumber: Byte;
  65.   x,y:Word;
  66. begin
  67.   bmNumber := Random(2) + 1;
  68.   MyHDC := GetWindowDC(hWindow);
  69.   MemHDC := CreateCompatibleDC(myHDC);
  70.   GetClientRect(hWindow,Rect);
  71.   SelectObject(MemHDC, hBmp[bmNumber]);
  72.   GetObject(hbmp[bmNumber], sizeof(BitMp), @BitMp);
  73.   x := random(Rect.Right - BitMp.bmWidth);
  74.   y := random(Rect.Bottom - BitMp.bmHeight);
  75.   StretchBlt(MyHdc, x, y, Bitmp.bmWidth,
  76.              Bitmp.bmHeight , memHDC, 0, 0,
  77.              Bitmp.bmWidth, bitmp.bmHeight, SRCcopy);
  78.   ReleaseDC(hWindow, MyHDC);
  79.   DeleteDC(MemHDC);
  80.   ReleaseDC(hWindow, MyHDC);
  81. end;
  82.  
  83. destructor TSaveWindow.Done;
  84. var
  85.   i: Integer;
  86. begin
  87.   for i := 1 to NumberOfBitmaps do
  88.     Deleteobject(hBmp[i]);
  89.   TScrnSavWindow.Done;
  90. end;
  91.  
  92. destructor TSaveApplication.Done;
  93. begin
  94.   TApplication.Done;
  95. end;
  96.  
  97. var
  98.   TSApp: TSaveApplication;
  99.  
  100. begin
  101.   TSApp.Init('Saver');
  102.   TSApp.Run;
  103.   TSApp.Done;
  104. end.
  105.